home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
comm
/
suncom.zip
/
TPZVIDEO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-01-19
|
5KB
|
242 lines
UNIT TpzVideo;
(* Status window routines for Turbo Pascal Zmodem *)
(* (c)1988 by J.R.Louvau *)
INTERFACE
USES Crt,Windows;
PROCEDURE Z_OpenWindow(title: STRING);
(* Setup the area of the screen for transfer status window *)
PROCEDURE Z_CloseWindow;
(* Restore the original window *)
PROCEDURE Z_ShowName(filename: STRING);
(* Display the file name *)
PROCEDURE Z_ShowSize(l: LONGINT);
(* Display the file size in blocks and bytes *)
PROCEDURE Z_ShowCheck(is32: BOOLEAN);
(* Display CRC16 or CRC32 block checking *)
PROCEDURE Z_ShowTransferTime(fsize, zbaud: LONGINT);
(* Show estimated transfer time in minutes *)
PROCEDURE Z_Message(s: STRING);
(* Show miscelaneous messages *)
PROCEDURE Z_Frame(n: INTEGER);
(* Show current ZMODEM frame type *)
PROCEDURE Z_ShowLoc(l: LONGINT);
(* Show byte position of file in blocks and bytes *)
PROCEDURE Z_Errors(w: WORD);
(* Show total error count *)
IMPLEMENTATION
CONST
x1: BYTE = 20;
x2: BYTE = 59;
y1: BYTE = 5;
y2: BYTE = 17;
{$F+}
{$L \turbo5\util\mcmvsmem.obj }
PROCEDURE MoveToScreen(var Source, Dest; Len: WORD);external;
PROCEDURE MoveFromScreen(var Source, Dest; Len: WORD);external;
{$F-}
VAR
vmode: BYTE absolute $0040:$0049;
vcols: WORD absolute $0040:$004A;
oldx, oldy, oldattr: BYTE;
oldmin, oldmax, cols, rows, size, vseg, vofs: WORD;
buffer: POINTER;
FUNCTION RtoS(r: REAL; width, decimals: WORD): STRING;
VAR
s: STRING;
BEGIN
{$I-}
Str(r:width:decimals,s);
{$I+}
IF (IoResult <> 0) THEN
s := ''
ELSE
WHILE (Length(s) > 0) AND (s[1] = ' ') DO
Delete(s,1,1);
RtoS := s
END;
FUNCTION ItoS(r: LONGINT; width: WORD): STRING;
VAR
s: STRING;
BEGIN
{$I-}
Str(r:width,s);
{$I+}
IF (IoResult <> 0) THEN
s := ''
ELSE
WHILE (Length(s) > 0) AND (s[1] = ' ') DO
Delete(s,1,1);
ItoS := s
END;
PROCEDURE Z_OpenWindow(title: STRING);
VAR
p, q: POINTER;
n, pads, bytes: WORD;
BEGIN
DirectVideo := TRUE;
CheckSnow := FALSE;
MAKEWINDOW(white,blue,4,0,x1,y1,x2,y2);
window(x1,y1,x2,y2);
textcolor(yellow);
gotoXY(13,1);
write(title);
window(1,1,80,25);
GotoXY(33,17);
write('ESCape to abort');
SETSCREEN(yellow,blue,0,x1+1,y1+1,x2-1,y2-1);
WRITELN(' File name.....:');
WRITELN(' File size.....:');
WRITELN(' File blocks...:');
WRITELN(' Block check...:');
WRITELN(' Transfer time.:');
WRITELN(' Current BYTE..:');
WRITELN(' Current BLOCK.:');
WRITELN(' Error count...:');
WRITELN(' Last frame....:');
TextColor(lightcyan);
TextBackground(blue);
write(' MESSAGES');
ClrEol;
textcolor(white);
END;
PROCEDURE Z_CloseWindow;
BEGIN
SETSCREEN(white,black,0,1,1,80,24);
gotoxy(1,1);
END;
PROCEDURE Z_ShowName(filename: STRING);
BEGIN
IF (Length(filename) > 14) THEN
filename[0] := #14;
GotoXY(18,1);
WRITE(filename);
GotoXY(1,11)
END;
PROCEDURE Z_ShowSize(l: LONGINT);
BEGIN
GotoXY(18,2);
WRITE(ItoS(l,14));
IF (l MOD 128 <> 0) THEN
l := (l DIV 128) + 1
ELSE
l := (l DIV 128);
GotoXY(18,3);
WRITE(ItoS(l,14));
GotoXY(1,11);
END;
PROCEDURE Z_ShowCheck(is32: BOOLEAN);
BEGIN
GotoXY(18,4);
IF (is32) THEN
WRITE('CRC32')
ELSE
WRITE('CRC16');
GotoXY(1,11)
END;
PROCEDURE Z_ShowTransferTime(fsize, zbaud: LONGINT);
VAR
bits: REAL;
BEGIN
bits := fsize * 10.0;
GotoXY(18,5);
IF (bits <> 0.0) THEN
WRITE(RtoS(((bits / zbaud) / 60),10,2),'min.')
ELSE
WRITE('0min.');
GotoXY(1,11)
END;
PROCEDURE Z_Message(s: STRING);
BEGIN
IF (Length(s) > 31) THEN
s[0] := #31;
GotoXY(1,11);
ClrEol;
WRITE(s,#13);
END;
PROCEDURE Z_Frame(n: INTEGER);
VAR Num : Byte;
BEGIN
IF (n < -3) OR (n > 20) THEN
n := 20;
GotoXY(18,9);
Num := Lo(n);
if Num = -3
then WRITE('ZNOCARRIER')
else if Num = -2
then WRITE('ZTIMEOUT ')
else if Num = -1
then WRITE('ZERROR ')
else
CASE Lo(n) OF
0 : WRITE('ZRQINIT ');
1 : WRITE('ZRINIT ');
2 : WRITE('ZSINIT ');
3 : WRITE('ZACK ');
4 : WRITE('ZFILE ');
5 : WRITE('ZSKIP ');
6 : WRITE('ZNAK ');
7 : WRITE('ZABORT ');
8 : WRITE('ZFIN ');
9 : WRITE('ZRPOS ');
10 : WRITE('ZDATA ');
11 : WRITE('ZEOF ');
12 : WRITE('ZFERR ');
13 : WRITE('ZCRC ');
14 : WRITE('ZCHALLENGE');
15 : WRITE('ZCOMPL ');
16 : WRITE('ZCAN ');
17 : WRITE('ZFREECNT ');
18 : WRITE('ZCOMMAND ');
19 : WRITE('ZSTDERR ');
20 : WRITE('ZUNKNOWN ')
END;
GotoXY(1,11)
END;
PROCEDURE Z_ShowLoc(l: LONGINT);
BEGIN
GotoXY(18,6);
WRITE(ItoS(l,14));
IF (l MOD 128 <> 0) THEN
l := (l DIV 128) + 1
ELSE
l := (l DIV 128);
GotoXY(18,7);
WRITE(ItoS(l,14));
GotoXY(1,11)
END;
PROCEDURE Z_Errors(w: WORD);
BEGIN
GotoXY(18,8);
WRITE(ItoS(w,14));
GotoXY(1,11)
END;
END.